home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 2.iso
/
BARNET
/
COMPILER
/
SATHER
/
!Sather
/
Library
/
Base
/
sa
/
flt
< prev
next >
Wrap
Text File
|
1996-07-18
|
20KB
|
662 lines
---------------------------> Sather 1.1 source file <--------------------------
-- Copyright (C) International Computer Science Institute, 1994. COPYRIGHT --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in --
-- the file "Doc/License" of the Sather distribution. The license is also --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA. --
--------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
immutable class FLT < $NUMBER{FLT}, $HASH, $FMT is
-- IEEE 754-1984 "single" format 32-bit floating point.
-- Most of these functions presently just call the FLTD versions
-- because of C double/float calling convention weirdness; this
-- is the most portable way.
include COMPARABLE;
plus(f:SAME):SAME is
-- The sum of self and `f'. Built-in.
builtin FLT_PLUS;
end;
minus(f:SAME):SAME is
-- The difference between self and `f'. Built-in.
builtin FLT_MINUS;
end;
negate:SAME is
-- The negation of self. Same as zero minus self,
-- except that IEEE does funny things for the sign bit and
-- different rounding modes.
builtin FLT_NEGATE;
end;
times(f:SAME):SAME is
-- The signed product of self and `f'. Built-in.
builtin FLT_TIMES;
end;
div(f:SAME):SAME is
-- The quotient of self and `f'. Built-in.
builtin FLT_DIV;
end;
is_eq(f:SAME):BOOL is
-- True if self and `f' represent the same value. Built-in.
builtin FLT_IS_EQ;
end;
is_lt(f:SAME):BOOL is -- True if self is less than `f'. Built-in.
builtin FLT_IS_LT;
end;
is_bet(l,u:SAME):BOOL is
-- Another name for `is_between'.
return self.is_between(l,u)
end;
is_between(l,u:SAME):BOOL is
-- True if self between l and u.
return (l<=self and self<=u) or (u<=self and self<=l) end;
is_within(tolerance,val:SAME):BOOL is
return (self-val).abs<=tolerance;
end;
hash:INT is
-- A lousy hash function, can someone suggest better?
return truncate.int.hash;
end;
is_finite:BOOL is -- returns true if zero, subnormal or normal.
return RUNTIME::ir_finite(self);
end;
is_inf:BOOL is -- returns true if infinite
return RUNTIME::ir_isinf(self);
end;
is_nan:BOOL is
-- returns true if NaN. See comment at "is_nil".
return ~(self=self);
end;
is_normal:BOOL is -- returns true if normal
builtin IR_ISNORMAL;
end;
is_subnormal:BOOL is -- returns true if subnormal
builtin IR_ISSUBNORMAL;
end;
is_zero:BOOL is -- returns true is zero
builtin IR_ISZERO;
end;
signbit_set:BOOL is -- returns true if sign bit of self is set
builtin IR_SIGNBIT;
end;
unbiased_exponent:INT is
-- return unbiased exponent of self as an INT;
-- for zero this is INT::maxint.negate, for an
-- infinite it is INT::maxint. If subnormal,
-- normalization occurs first.
builtin IR_ILOGB;
end;
copysign(y:SAME):SAME is
-- return self with the sign bit set to the same as y's sign bit.
builtin R_COPYSIGN;
end;
nextup:SAME is -- return next representable number from self.
builtin R_NEXTUP;
end;
nextdown:SAME is
-- return previous representable number from self.
builtin R_NEXTDOWN;
end;
remainder(y:SAME):SAME is
-- x.remainder(y) and x.mod(y) return a remainder of x with respect
-- to y; that is, the result r is one of the numbers that differ from
-- x by an integral multiple of y. Thus (x-r)/y is an integral
-- value, even though it might exceed INT::maxint if it were
-- explicitly computed as an INT. Both functions return one of the
-- two such r smallest in magnitude. remainder(x,y) is the operation
-- specified in ANSI/IEEE Std 754-1985; the result of x.mod(y) may
-- differ from remainder's result by +-y. The magnitude of
-- remainder's result can not exceed half that of y; its sign might
-- not agree with either x or y. The magnitude of mod's result is
-- less than that of y; its sign agrees with that of x. Neither
-- function will raise an exception as long as both arguments are
-- normal or subnormal. x.remainder(0), x.mod(0), infinity.remainder(y),
-- and infinity.mod(y) are invalid operations that produce a NaN.
builtin R_REMAINDER;
end;
mod(y:SAME):SAME is -- See comment at `remainder'.
builtin R_FMOD;
end;
scale_by(n:INT):SAME is
-- return x*2.pow(n) computed by exponent manipulation rather
-- than by actually performing an exponentiation or a multiplication.
--
-- 1 <= x.abs.scale_by(-x.unbiased_exponent) < 2
--
-- for every x except 0, infinity, and NaN.
builtin R_SCALBN;
end;
bessel_j0:SAME is
-- Bessel functions of the first and second kinds. y0, y1 and yn have
-- logarithmic singularities at the origin, so they treat zero and
-- negative arguments the way log does.
builtin R_J0;
end;
bessel_j1:SAME is
-- See comment at `bessel_j0'.
builtin R_J1;
end;
bessel_jn(n:INT):SAME is
-- See comment at `bessel_j0'.
builtin R_JN;
end;
bessel_y0:SAME is
-- See comment at `bessel_j0'.
builtin R_Y0;
end;
bessel_y1:SAME is
-- See comment at `bessel_j0'.
builtin R_Y1;
end;
bessel_yn(n:INT):SAME is
-- See comment at `bessel_j0'.
builtin R_YN;
end;
erf:SAME is
-- error function:
-- x.erf = (1/sqrt(pi))*integrate(0,x,exp(-t^2)dt)
builtin R_ERF;
end;
one_minus_erf:SAME is
-- 1.0-self.erf, but computed in a way to avoid
-- cancellation for large self.
builtin R_ERFC;
end;
exp:SAME is -- The exponential e^self.
-- Exponential, logarithm, power functions. All these functions handle
-- exceptional arguments in the spirit of IEEE 754-1985. So:
-- 0.log is -infinity with a division by zero exception
-- For x<0, including -infinity, x.log is a quiet NaN with an
-- invalid op exception
-- For x=+infinity or a quiet NaN, x.log is x without exception
-- For a signaling NaN, x.log is a quiet NaN with
-- an invalid op exception
-- 1.log is zero without exception
-- For any other positive x, x.log is a normalized number with an
-- inexact exception.
builtin R_EXP;
end;
exp_minus_one:SAME is -- e^self-1.0, accurate even for tiny self.
-- See comment at `exp'.
builtin R_EXPM1;
end;
exp2:SAME is -- 2^self
-- See comment at `exp'.
builtin R_EXP2;
end;
exp10:SAME is -- 10^self
-- See comment at `exp'.
builtin R_EXP10;
end;
log:SAME is -- The natural logarithm of self.
-- See comment at `exp'.
builtin R_LOG;
end;
plus_one_log:SAME is -- (self+1).log, accurate even for tiny self.
-- See comment at `exp'.
builtin R_LOG1P;
end;
log2:SAME is -- The logarithm base two of self.
-- See comment at `exp'.
return self.log*log2_e;
end;
log10:SAME is -- The logarithm base ten of self.
-- See comment at `exp'.
builtin R_LOG10;
end;
pow(arg:SAME):SAME is
-- self raised to the arg'th power. x.pow(0.0)=1.0 for all x.
-- See comment at `exp'.
builtin R_POW;
end;
acosh:SAME is -- The inverse hyperbolic cosine of self.
-- The hyperbolic functions handle exceptional arguments in the
-- spirit of IEEE 754-1985. So:
-- sinh and cosh return +-infinity on overflow
-- acosh returns a NaN if its argument is less than 1.0
-- atanh returns a NaN if its argument has an absolute value >1.0
builtin R_ACOSH;
end;
cosh:SAME is -- The hyperbolic cosine of self.
-- See comment at `acosh'.
builtin R_COSH;
end;
sinh:SAME is -- The hyperbolic sine of self.
-- See comment at `acosh'.
builtin R_SINH;
end;
tanh:SAME is -- The hyperbolic tangent of self.
-- See comment at `acosh'.
builtin R_TANH;
end;
asinh:SAME is -- The inverse hyperbolic sine of self.
-- See comment at `acosh'.
builtin R_ASINH;
end;
atanh:SAME is -- The inverse hyperbolic tangent of self.
-- See comment at `acosh'.
builtin R_ATANH;
end;
hypot(arg:SAME):SAME is
-- sqrt(self*self+arg*arg), taking precautions against unwarranted
-- IEEE exceptions. +-infinity.hypot(arg) is +infinity for any arg,
-- even a NaN, and is exceptional only for a signaling NaN.
builtin R_HYPOT;
end;
acos:SAME is
-- The arc sine of self in the range [0.0, pi].
-- The trigonometric functions handle exceptional arguments
-- in the spirit of IEEE 754-1985. So:
-- +-infinity.sin, +-infinity.cos, +-infinity.tan return NaN
-- x.asin and x.acos with x.abs>1 return NaN
-- sinpi etc. are similar except they compute
-- self.sinpi=(self*pi).sin avoiding range-reduction issues
-- because their definition permits range reduction that is fast
-- and exact for all self. The corresponding inverse functions
-- compute asinpi(x).
builtin R_ACOS;
end;
sin:SAME is -- See comment at `acos'.
builtin R_SIN;
end;
cos:SAME is -- See comment at `acos'.
builtin R_COS;
end;
sincos(out s:FLT,out c:FLT) is
-- Simultaneous computation of self.sin and self.cos. This is faster
-- than independently computing them.
-- See comment at `acos'.
builtin SINCOS;
end;
tan:SAME is
-- See comment at `acos'.
builtin R_TAN;
end;
asin:SAME is
-- The arc sine of self in the range [-pi/2, pi/2]
-- See comment at `acos'.
builtin R_ASIN;
end;
atan:SAME is
-- The arc tangent of self in the range [-pi/2, pi/2].
-- See comment at `acos'.
builtin R_ATAN;
end;
atan2(arg:SAME):SAME is
-- The arc tangent of self divided by arg in the range [-pi/2, pi/2].
-- It chooses the quadrant specified by (self, arg).
-- See comment at `acos'.
builtin R_ATAN2;
end;
sinpi:SAME is
-- See comment at `acos'.
builtin R_SINPI;
end;
cospi:SAME is
-- See comment at `acos'.
builtin R_COSPI;
end;
sincospi(out a:FLT,out b:FLT) is
-- Simultaneous computation of self.sinpi and self.cospi. Faster
-- than independently computing them.
-- See comment at `acos'.
builtin SINCOSPI;
end;
tanpi:SAME is
-- See comment at `acos'.
builtin R_TANPI;
end;
asinpi:SAME is
-- The arc sine of self*pi in the range [-pi/2, pi/2]
-- See comment at `acos'.
builtin R_ASINPI;
end;
acospi:SAME is
-- The arc sine of self*pi in the range [0.0, pi]
-- See comment at `acos'.
builtin R_ACOSPI;
end;
atanpi:SAME is
-- The arc tangent of self*pi in the range [-pi/2, pi/2].
-- See comment at `acos'.
builtin R_ATANPI;
end;
atan2pi(arg:SAME):SAME is
-- The arc tangent of self*pi divided by arg in the range [-pi/2, pi/2].
-- It chooses the quadrant specified by (self, arg).
-- See comment at `acos'.
builtin R_ATAN2PI;
end;
abs:SAME is -- The absolute value of self.
builtin R_FABS;
end;
sign:SAME is
-- -1.0, 0.0, or 1.0, depending whether the sign of self is
-- negative, zero, or positive.
if self<0.0 then return -1.0;
elsif self>0.0 then return 1.0;
else return 0.0;
end;
end;
signum:SAME is return sign end; -- Another name for `sign'.
log_gamma:SAME is
-- log gamma function. x.ln_gamma=x.gamma.abs.log
builtin R_LGAMMA;
end;
gamma:SAME is
-- gamma function.
if self>0.0 then return log_gamma.exp;
elsif integral then return 0.0;
elsif abs.floor.int.is_even then return (-log_gamma).exp;
else return log_gamma.exp;
end;
end;
sqrt:SAME is -- The square root of self.
builtin R_SQRT;
end;
square:SAME is -- The square of self.
return self*self;
end;
cube_root:SAME is -- The cube root of self.
builtin R_CBRT;
end;
cube:SAME is -- The cube of self.
return self*self*self;
end;
max(arg:SAME):SAME is -- The larger of self and arg.
-- Caution: may not work as one expects if an argument is NaN.
if self<arg then return arg; else return self; end;
end;
min(arg:SAME):SAME is -- The smaller of self and arg.
-- Caution: may not work as one expects if an argument is NaN.
if self<arg then return self; else return arg; end;
end;
at_least(arg:SAME):SAME is return self.max(arg) end; -- Same as `self.max(arg)'
at_most(arg:SAME):SAME is return self.min(arg) end; -- Same as `self.min(arg)'
str:STR is
-- A string version of self.
fbuf:FSTR:=#(30); -- This is poor, but makes it reentrant.
-- The other str methods work this way too
-- (they used to use a shared buffer.)
-- if ((void(fbuf)) or (fbuf.size < 30)) then fbuf := #FSTR(30) end;
fstr ::= str_in(fbuf);
return(fstr.str); end;
str(prec:INT):STR is
-- A string version of self with arg digits of precision.
des_sz ::= prec+10;
fbuf:FSTR:=#(des_sz); -- See comment in `str'.
-- if ((void(fbuf)) or (fbuf.size < des_sz)) then fbuf:=#FSTR(des_sz) end;
fstr ::= str_in(fbuf,prec);
return(fstr.str); end;
str_in(arg:FSTR):FSTR is
store_in: FSTR;
if (arg.size >= 30) then store_in := arg;
else store_in := #FSTR(30) end;
sz ::= store_into(store_in);
store_in.loc := sz;
return(store_in); end;
str_in(arg: FSTR, prec: INT): FSTR is
store_in: FSTR;
des_sz ::= prec+10;
if (arg.size >= des_sz) then store_in := arg;
else store_in := #FSTR(des_sz) end;
sz ::= store_into_prec(prec, store_in);
store_in.loc := sz;
return(store_in); end;
private store_into(s:FSTR):INT is
-- Store the acsii representation into s. Built-in.
builtin FLT_STORE_INTO;
end;
private store_into_prec(p:INT,s:FSTR):INT is
-- Store the acsii representation into s with precision p. Built-in.
builtin FLT_STORE_PREC;
end;
fmt( f:STR ): STR is
-- Return a nicely formatted ascii representation of the number.
-- See the separate documentation on FMT for a full description.
return BASE_FORMAT::fmt_flt( self, f )
end;
create (s: STR): SAME is
builtin ATOF;
end;
create(f:INT):SAME is return f.flt end;
create(f:INTI):SAME is return f.flt end;
create(f:FLT):SAME is return f end;
create(f:FLTD):SAME is return f.flt end;
-- create(f:FLTX):SAME is return f.flt end;
-- create(f:FLTDX):SAME is return f.flt end;
-- create(f:FLTI):SAME is return f.flt end;
integral:BOOL is
-- Another name for `is_integral'.
return self.is_integral
end;
is_integral:BOOL is
-- Return true if self is integral.
return self=truncate;
end;
int:INT is
-- INT version of self. It is an error if self is not integral.
-- Use truncate, floor, ceiling, or round to achieve this.
-- Built-in.
builtin FLT_INT;
end;
inti:INTI is return #INTI(self) end; -- Conversion to INTI.
flt:FLT is return self end; -- Conversion to FLT (identity operation)
fltd:FLTD is
-- An FLTD version of self. Built-in.
builtin FLT_FLTD; end;
get_representation(out sign:BOOL,out exp: INT,out mantissa: INT)
-- Get the data representing te flt. (endian independant)
is
builtin FLT_GET_REP;
end;
truncate:SAME is -- The nearest integer toward zero. Built-in.
builtin FLT_TRUNCATE;
end;
floor:SAME is -- The largest integer not greater than self.
builtin R_FLOOR;
-- return RUNTIME::r_floor(self);
end;
ceiling:SAME is -- The smallest integer not less than self.
builtin R_CEIL;
-- return RUNTIME::r_ceil(self);
end;
round:SAME is -- The closest integer to self.
builtin FLT_ROUND;
end;
const pi:SAME:=FLTD::pi.flt; -- An approximation of the mathematical value "pi".
const e:SAME:=FLTD::e.flt; -- An approximation of the base of the natural logarithms "e".
const sqrt_2:SAME:=FLTD::sqrt_2.flt; -- Approximation of 2.sqrt.
const log_2:SAME:=FLTD::log_2.flt; -- Approximation of 2.log.
const log2_e:SAME:=FLTD::log2_e.flt; -- Approximation of e.log2.
const log10_e:SAME:=FLTD::log10_e.flt; -- Approximation of e.log10.
const log_10:SAME:=FLTD::log_10.flt; -- Approximation of 10.log.
const half_pi:SAME:=FLTD::half_pi.flt; -- Approximation of pi/2.
const quarter_pi:SAME:=FLTD::quarter_pi.flt; -- Approximation of pi/4.
const inv_sqrt_2:SAME:=FLTD::inv_sqrt_2.flt; -- Approximation of 1/(2.sqrt).
const inv_pi:SAME:=FLTD::inv_pi.flt; -- Approximation of 1/pi.
const double_inv_pi:SAME:=FLTD::double_inv_pi.flt; -- Approximation of 2/pi
const double_sqrt_pi:SAME:=FLTD::double_sqrt_pi.flt;
-- Approximation of 2*(pi.sqrt).
nil:SAME is
-- The value to be used to represent no element in sets.
return signaling_NaN(0);
end;
is_nil:BOOL is
return ~(self=self);
-- Blame IEEE arithmetic for this. I know how awful it looks.
-- It works because NaN is the only value which won't compare
-- with anything.
end;
signaling_NaN(sig:INT):SAME is
-- IEEE signalling NaN. `sig' is the significand (presently unused).
builtin R_SIGNALING_NAN;
end;
quiet_NaN(sig:INT):SAME is
-- IEEE quiet NaN. `sig' is the significand (presently unused).
builtin R_QUIET_NAN;
end;
infinity:SAME is -- IEEE Infinity.
builtin R_INFINITY;
end;
const zero:SAME := 0.0; -- See $NUMBER.
const one: SAME := 1.0;
maxval:SAME is return infinity; end; -- Maximal value; see $NUMBER.
minval:SAME is return -infinity; end; -- Minimal value; see $NUMBER.
const epsilon:SAME:=1.19209290e-07; -- The minimum x>0.0 such that 1.0+x/=x.
const digits:INT:=6; -- The number of decimal digits of precision.
const mantissa_bits:INT:=24; -- The number of bits in the significand, including an implied bit.
min_normal:SAME is -- The smallest normalized positive number.
builtin MIN_NORMAL;
end;
max_normal:SAME is -- The largest normalized positive number.
builtin MAX_NORMAL;
end;
min_subnormal:SAME is -- The smallest subnormal positive number.
builtin MIN_SUBNORMAL;
end;
max_subnormal:SAME is -- The largest subnormal positive number.
builtin MAX_SUBNORMAL;
end;
const min_exp:INT:=-125;
-- The minimum negative integer x such that b^(x-1) is in the range
-- of normalized floating point numbers.
const min_exp10:INT:=-37;
-- The minimum x such that 10^x is in the range of normalized
-- floating point numbers.
const max_exp:INT:=128; -- The maximum allowable exponent.
const max_exp10:INT:=38;-- The maximum x such that 10^x is within range.
sum!(i:SAME):SAME is
-- Yields the sum of all previous values of `i'.
r::=0.0; loop r:=r+i; yield r end
end;
product!(i:SAME):SAME is
-- Yields the product of all previous values of `i'.
r::=1.0; loop r:=r*i; yield r end
end;
end; -- class FLT